home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / program / cwaudit.zip / CWAUDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-21  |  4KB  |  180 lines
  1. {
  2.  Author:    Craig Ward
  3.  Copyright: none - public domain
  4.  
  5.  Date:      21/5/96
  6.  
  7.  Version:   1.0
  8.  
  9.  Overview:  Audit-Trail component. Logs database actions to text-file, plus,
  10.             shows audit-trail in a TOutline.
  11.  
  12.  Calling:   Two calls available:
  13.              [1] WriteAction - this writes the info passed to a text file
  14.              [2] Execute - shows dialog
  15.  
  16.  Fields:    Before using the component, do not forget to set the text-file
  17.             property, plus the user-name property!
  18.  
  19. *******************************************************************************}
  20. unit Cwaudit;
  21.  
  22. interface
  23.  
  24. uses
  25.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  26.   Forms, Dialogs, DB, DBTables;
  27.  
  28.  
  29. type
  30.   TcwAuditTrail = class(TComponent)
  31.   private
  32.     { Private declarations }
  33.     FPrevDate: string;
  34.     FPrevUser: string;
  35.     FTextFile: string;
  36.     FUserName: string;
  37.     procedure SetTextFile(const value: string);
  38.     procedure SetUser(const value: string);
  39.   protected
  40.     { Protected declarations }
  41.   public
  42.     { Public declarations }
  43.     procedure WriteAction(const sTable, sAction: string);
  44.     function Execute: boolean;
  45.     constructor Create(aOwner: TComponent); override;
  46.     destructor Destroy; override;
  47.   published
  48.     { Published declarations }
  49.     property AuditLog: string read FTextFile write SetTextFile;
  50.     property UserName: string read FUserName write SetUser;
  51.   end;
  52.  
  53. procedure Register;
  54.  
  55. implementation
  56.  
  57. uses
  58.  cwaudDlg;
  59.  
  60. {***VCL Preferences************************************************************}
  61.  
  62. {register}
  63. procedure Register;
  64. begin
  65.   RegisterComponents('cw_apps', [TcwAuditTrail]);
  66. end;
  67.  
  68.  
  69. {create}
  70. constructor TcwAuditTrail.Create(aOwner: TComponent);
  71. begin
  72.  inherited Create(aOwner);
  73. end;
  74.  
  75. {free}
  76. destructor TcwAuditTrail.Destroy;
  77. begin
  78.  inherited destroy;
  79. end;
  80.  
  81. {set text file}
  82. procedure TcwAuditTrail.SetTextFile(const value: string);
  83. begin
  84.  if FTextFile <> value then
  85.   FTextFile := value;
  86. end;
  87.  
  88. {set user}
  89. procedure TcwAuditTrail.SetUser(const value: string);
  90. begin
  91.  if FUserName <> value then
  92.   FUserName := value;
  93. end;
  94.  
  95. {***I\O************************************************************************}
  96.  
  97. {write exception message to text file}
  98. procedure TcwAuditTrail.WriteAction(const sTable, sAction: string);
  99. var
  100.  tf: TextFile;
  101.  tc: file of char;
  102.  sLine: ^string;
  103. begin
  104.  
  105.  {check if file is empty - user could have purged it! -
  106.   in which case, reset the fields that store previous
  107.   values}
  108.  if fileExists(FTextFile) then
  109.   begin
  110.    AssignFile(tc,FTextFile);
  111.    reset(tc);
  112.    if FileSize(tc) = 0 then
  113.     begin
  114.      FPrevDate := '';
  115.      FPrevUser := '';
  116.     end;
  117.    CloseFile(tc);
  118.   end;
  119.  
  120.  
  121.  New(sLine);
  122.  
  123.  {add text to file}
  124.  try
  125.  
  126.  if FTextFile <> '' then
  127.   begin
  128.    AssignFile(tf,FTextFile);                        {assign field to Text-File}
  129.    if FileExists( FTextFile ) then
  130.     Append(tf)       {prepare to append to file}
  131.    else
  132.     Rewrite(tf);   {create and open}
  133.     {write data to file. Since we will present the data
  134.      in a TListBox, where children can be defined using a tab (#9),
  135.      we check the last log, to see if we should write new information}
  136.    if FPrevDate <> DateToStr(date) then
  137.     WriteLn(tF,DateToStr(date));
  138.    {***}
  139.    if FPrevUser <> FUsername then
  140.     WriteLn(tF,#9+FUserName);
  141.    {***}
  142.    sLine^ := #9+#9+ sAction +' '+ sTable +' at '+ TimeToStr(time);
  143.    WriteLn(tF,sLine^);
  144.    CloseFile(tF); {close file}
  145.    {store information for next log}
  146.    FPrevDate := DateToStr(date);
  147.    FPrevUser := FUsername;
  148.   end;
  149.  finally
  150.   Dispose(sLine);
  151.  end;
  152.  
  153. end;
  154.  
  155.  
  156. {***form***********************************************************************}
  157.  
  158. {show audit dialog}
  159. function TcwAuditTrail.Execute: boolean;
  160. begin
  161.  result := false;
  162.  screen.cursor := crHourGlass;
  163.  AuditDlg := TAuditDlg.create(application);
  164.  try
  165.   AuditDlg.TextFile := FTextFile;
  166.   AuditDlg.caption := 'Audit Trail';
  167.   {show}
  168.   screen.cursor := crDefault;
  169.   AuditDlg.showModal;
  170.   result := true;
  171.  finally
  172.   AuditDlg.Free;
  173.   screen.cursor := crDefault;
  174.  end;
  175. end;
  176.  
  177.  
  178. {}
  179. end.
  180.